home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbasicpg.zip / EDPAT.BAS < prev    next >
BASIC Source File  |  1987-09-22  |  6KB  |  212 lines
  1. DECLARE SUB DrawPattern ()
  2. DECLARE SUB EditPattern ()
  3. DECLARE SUB Initialize ()
  4. DECLARE SUB ShowPattern (OK$)
  5.  
  6. DIM Bit%(0 TO 7), Pattern$, Esc$, PatternSize%
  7.  
  8. DO
  9.    Initialize
  10.    EditPattern
  11.    ShowPattern OK$
  12. LOOP WHILE OK$ = "Y"
  13.  
  14. END
  15. '
  16. ' ======================== DRAWPATTERN =======================
  17. '    Draws a patterned rectangle on the right side of screen
  18. ' ============================================================
  19. '
  20. SUB DrawPattern STATIC
  21. SHARED Pattern$
  22.  
  23.    VIEW (320, 24)-(622, 160), 0, 1  ' Set view to rectangle
  24.    PAINT (1, 1), Pattern$           ' Use PAINT to fill it
  25.    VIEW                             ' Set view to full screen
  26.  
  27. END SUB
  28. '
  29. ' ======================== EDITPATTERN =======================
  30. '                  Edits a tile-byte pattern
  31. ' ============================================================
  32. '
  33. SUB EditPattern STATIC
  34. SHARED Pattern$, Esc$, Bit%(), PatternSize%
  35.  
  36.    ByteNum% = 1         ' Starting position.
  37.    BitNum% = 7
  38.    Null$ = CHR$(0)      ' CHR$(0) is the first byte of the
  39.                         ' two-byte string returned when a
  40.                         ' direction key such as UP or DOWN is
  41.                         ' pressed.
  42.    DO
  43.  
  44.       ' Calculate starting location on screen of this bit:
  45.       X% = ((7 - BitNum%) * 16) + 80
  46.       Y% = (ByteNum% + 2) * 8
  47.  
  48.       ' Wait for a key press (and flash cursor each 3/10 second):
  49.       State% = 0
  50.       RefTime = 0
  51.       DO
  52.  
  53.          ' Check timer and switch cursor state if 3/10 second:
  54.          IF ABS(TIMER - RefTime) > .3 THEN
  55.             RefTime = TIMER
  56.             State% = 1 - State%
  57.  
  58.             ' Turn the  border of bit on and off:
  59.             LINE (X% - 1, Y% - 1)-STEP(15, 8), State%, B
  60.          END IF
  61.  
  62.          Check$ = INKEY$        ' Check for key press.
  63.  
  64.       LOOP WHILE Check$ = ""    ' Loop until a key is pressed.
  65.  
  66.       ' Erase cursor:
  67.       LINE (X% - 1, Y% - 1)-STEP(15, 8), 0, B
  68.  
  69.       SELECT CASE Check$        ' Respond to key press.
  70.  
  71.          CASE CHR$(27)          ' ESC key pressed:
  72.             EXIT SUB            ' exit this subprogram
  73.  
  74.          CASE CHR$(32)          ' SPACEBAR pressed:
  75.                                 ' reset state of bit
  76.  
  77.             ' Invert bit in pattern string:
  78.             CurrentByte% = ASC(MID$(Pattern$, ByteNum%, 1))
  79.             CurrentByte% = CurrentByte% XOR Bit%(BitNum%)
  80.             MID$ (Pattern$, ByteNum%) = CHR$(CurrentByte%)
  81.  
  82.             ' Redraw bit on screen:
  83.             IF (CurrentByte% AND Bit%(BitNum%)) <> 0 THEN
  84.                 CurrentColor% = 1
  85.             ELSE
  86.                 CurrentColor% = 0
  87.             END IF
  88.             LINE (X% + 1, Y% + 1)-STEP(11, 4), CurrentColor%, BF
  89.  
  90.          CASE CHR$(13)           ' ENTER key pressed:
  91.             DrawPattern          ' draw pattern in box on right.
  92.  
  93.          CASE Null$ + CHR$(75)   ' LEFT key: move cursor left
  94.  
  95.             BitNum% = BitNum% + 1
  96.             IF BitNum% > 7 THEN BitNum% = 0
  97.  
  98.          CASE Null$ + CHR$(77)   ' RIGHT key: move cursor right
  99.  
  100.             BitNum% = BitNum% - 1
  101.             IF BitNum% < 0 THEN BitNum% = 7
  102.  
  103.          CASE Null$ + CHR$(72)   ' UP key: move cursor up
  104.  
  105.             ByteNum% = ByteNum% - 1
  106.             IF ByteNum% < 1 THEN ByteNum% = PatternSize%
  107.  
  108.          CASE Null$ + CHR$(80)   ' DOWN key: move cursor down
  109.  
  110.             ByteNum% = ByteNum% + 1
  111.             IF ByteNum% > PatternSize% THEN ByteNum% = 1
  112.  
  113.          CASE ELSE
  114.             ' User pressed a key other than ESC, SPACEBAR,
  115.             ' ENTER, UP, DOWN, LEFT, or RIGHT, so don't
  116.             ' do anything.
  117.       END SELECT
  118.    LOOP
  119. END SUB
  120. '
  121. ' ======================== INITIALIZE ========================
  122. '               Sets up starting pattern and screen
  123. ' ============================================================
  124. '
  125. SUB Initialize STATIC
  126. SHARED Pattern$, Esc$, Bit%(), PatternSize%
  127.  
  128.    Esc$ = CHR$(27)              ' ESC character is ASCII 27.
  129.  
  130.    ' Set up an array holding bits in positions 0 to 7:
  131.    FOR I% = 0 TO 7
  132.       Bit%(I%) = 2 ^ I%
  133.    NEXT I%
  134.  
  135.    CLS
  136.  
  137.    ' Input the pattern size (in number of bytes):
  138.    LOCATE 5, 5
  139.    PRINT "Enter pattern size (1-16 rows):";
  140.    DO
  141.       LOCATE 5, 38
  142.       PRINT "    ";
  143.       LOCATE 5, 38
  144.       INPUT "", PatternSize%
  145.    LOOP WHILE PatternSize% < 1 OR PatternSize% > 16
  146.  
  147.    ' Set initial pattern to all bits set:
  148.    Pattern$ = STRING$(PatternSize%, 255)
  149.  
  150.    SCREEN 2                ' 640 x 200 monochrome graphics mode.
  151.  
  152.    ' Draw dividing lines:
  153.    LINE (0, 10)-(635, 10), 1
  154.    LINE (300, 0)-(300, 199)
  155.    LINE (302, 0)-(302, 199)
  156.  
  157.    ' Print titles:
  158.    LOCATE 1, 13: PRINT "Pattern Bytes"
  159.    LOCATE 1, 53: PRINT "Pattern View"
  160.  
  161.    ' Draw editing screen for pattern:
  162.    FOR I% = 1 TO PatternSize%
  163.  
  164.       ' Print label on left of each line:
  165.       LOCATE I% + 3, 8
  166.       PRINT USING "##:"; I%
  167.  
  168.       ' Draw "bit" boxes:
  169.       X% = 80
  170.       Y% = (I% + 2) * 8
  171.       FOR J% = 1 TO 8
  172.          LINE (X%, Y%)-STEP(13, 6), 1, BF
  173.          X% = X% + 16
  174.       NEXT J%
  175.    NEXT I%
  176.  
  177.    DrawPattern                  ' Draw  "Pattern View" box.
  178.  
  179.    LOCATE 21, 1
  180.    PRINT "DIRECTION keys........Move cursor"
  181.    PRINT "SPACEBAR............Changes point"
  182.    PRINT "ENTER............Displays pattern"
  183.    PRINT "ESC.........................Quits";
  184.  
  185. END SUB
  186. '
  187. ' ======================== SHOWPATTERN =======================
  188. '     Prints the CHR$ values used by PAINT to make pattern
  189. ' ============================================================
  190. '
  191. SUB ShowPattern (OK$) STATIC
  192. SHARED Pattern$, PatternSize%
  193.  
  194.    ' Return screen to 80-column text mode:
  195.    SCREEN 0, 0
  196.    WIDTH 80
  197.  
  198.    PRINT "The following characters make up your pattern:"
  199.    PRINT
  200.  
  201.    ' Print out the value for each pattern byte:
  202.    FOR I% = 1 TO PatternSize%
  203.       PatternByte% = ASC(MID$(Pattern$, I%, 1))
  204.       PRINT "CHR$("; LTRIM$(STR$(PatternByte%)); ")"
  205.    NEXT I%
  206.  
  207.    PRINT
  208.    LOCATE , , 1
  209.    PRINT "New pattern? ";
  210.    OK$ = UCASE$(INPUT$(1))
  211. END SUB
  212.